perm filename CLIP.F4[IRC,LCS] blob
sn#493208 filedate 1980-01-11 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE CLIP(J,K,L)
C00005 ENDMK
Cā;
SUBROUTINE CLIP(J,K,L)
C (AC13,AC14,AC7)
COMMON /JCLIP/MC,NC,N
C ASSUMES N IS INITIALIZED =0
DATA MC/200/,NC/600/
C SMALL DIM. OF PAPER IS C.600 TO -1000 MOVE IN 400 INCREMENTS.
IF(L.NE.3)GO TO 1
C NOW INBOUNDS
N=0
IF(K.LT.MC.OR.K.GE.NC)N=-1
GO TO 4
1 IF(N.EQ.0)GO TO 11
C JUMP IF LAST POINT WAS IN BOUNDS
C NOW JJ IS OUT OF BOUNDS, CLIP IT
5 IF(K.LT.MC.AND.KK.LT.MC)GO TO 9
IF(K.GE.NC.AND.KK.GE.NC)GO TO 9
C GO BACK IF ENTIRE SEGMENT IS OUT OF BOUNDS
6 CALL CL(JX,KX,J,K,JJ,KK)
C CLIP FROM INVIS VECT WHICH IS OUT OF BOUNDS OR V-V
8 CALL NVECT(JX,KX)
C GO PUT AWAY CLIPPED VECTOR POINT, THEN NEW POINT
C CLIP MORE IF OTHER POINT IS ALSO OUT.
11 IF(K.LT.MC.OR.K.GE.NC)GO TO 7
N=0
GO TO 4
9 N=-1
4 JJ=J
KK=K
C REMEMBER THE COORDS.
RETURN
7 CALL CL(JX,KX,JJ,KK,J,K)
JJ=J
KK=K
J=JX
K=KX
N=1
RETURN
END
SUBROUTINE CL(JX,KX,J,K,JJ,KK)
C RETURN -- IN -- OUT
COMMON /JCLIP/MC,NC
C JJ,KK=OLD POINT J,K=NEW POINT JX,KX=CLIPPED
KX=NC-1
IF(KK.LT.NC)KX=MC
C JUMP IF OFF TOP OF AREA
C NOW IT'S OFF BOTTOM OF AREA
1 A=KK-K
B=(JJ-J)*(KX-K)
C=B/A
JX=J+C
C NOW THE VECT. IS FROM KX,JX TO J,K -- ALL INBOUNDS.
END